home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / star-1_0.tar / eval.c < prev    next >
C/C++ Source or Header  |  1991-03-22  |  28KB  |  1,467 lines
  1. /* eval.c -- STAR Functions and Operators
  2.  
  3. This file is part of STAR, the Saturn Macro Assembler.
  4.  
  5.    STAR is not distributed by the Free Software Foundation. Do not ask
  6. them for a copy or how to obtain new releases. Instead, send e-mail to
  7. the address below. STAR is merely covered by the GNU General Public
  8. License.
  9.  
  10. Please send your comments, ideas, and bug reports to
  11. Jan Brittenson <bson@ai.mit.edu>
  12.  
  13. */
  14.  
  15.  
  16. /* Copyright (C) 1990, 1991 Jan Brittenson.
  17.  
  18.    STAR is free software; you can redistribute it and/or modify it
  19. under the terms of the GNU General Public License as published by the
  20. Free Software Foundation; either version 1, or (at your option) any
  21. later version.
  22.  
  23.    STAR is distributed in the hope that it will be useful, but WITHOUT
  24. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  25. FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  26. for more details.
  27.  
  28.    You should have received a copy of the GNU General Public License
  29. along with STAR; see the file COPYING. If not, to obtain a copy, write
  30. to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
  31. USA, or send e-mail to bson@ai.mit.edu. */
  32.  
  33. /*
  34.  * All the 'evxx' routines are called with a standard interface:
  35.  *
  36.  *    OPX:    struct val opx(cpp, term)    opx = op term;
  37.  *            char **cpp;
  38.  *            struct val term;
  39.  *
  40.  *    XOPY:    struct val xopy(cpp, term1, term2)
  41.  *            char **cpp;
  42.  *            struct val term1, term2;  xopy = term1 op term2;
  43.  */
  44.  
  45. #include <stdio.h>
  46. #include <math.h>
  47. #include "star.h"
  48. #include "literals.h"
  49. #include "symbols.h"
  50.  
  51.  
  52. /* External functions/data */
  53. extern SYM_ROOT
  54.   *symtbl;
  55. extern
  56.   errcnt, pass;
  57. extern char
  58.   *str();
  59.  
  60.  
  61. /* Global variables/data */
  62. int noseq;
  63.  
  64.  
  65. /* Make sure valid digit */
  66. is_digit(c)
  67.   char c;
  68. {
  69.   if(!isdigit(c))
  70.     {
  71.       sgnerr("Invalid number");
  72.       return(FALSE);
  73.     }
  74.   return(TRUE);
  75. }
  76.  
  77.  
  78. /* Compute current instance level of
  79.  * existing symbol.
  80.  */
  81. instances_sym(symp)
  82.   struct sstruct *symp;
  83. {
  84.   int n;
  85.   register struct vnode *vp;
  86.  
  87.   if(!symp)
  88.     return(0);
  89.  
  90.   for(n = 1, vp = symp->vlink; vp; n++, vp = vp->vlink);
  91.   
  92.   return(n);
  93. }
  94.  
  95.  
  96. /* Compute current instance level of
  97.  * symbol, return 0 if symbol does not exist.
  98.  */
  99. instances(name)
  100.   char *name;
  101. {
  102.   return(instances_sym(sm_find_sym(symtbl, name)));
  103. }
  104.   
  105.  
  106. /* XOPY:  Not equal */
  107. struct val evbne(cpp, term1, term2)
  108.   char **cpp;
  109.   struct val term1, term2;
  110. {
  111.   if(term1.type != term2.type)
  112.     return(val_one);
  113.  
  114.   switch(term1.type)
  115.     {
  116.     case VT_INT: return(intval(term1.vint != term2.vint));
  117.     case VT_REAL: return(intval(term1.vdouble != term2.vdouble));
  118.     case VT_STR: return(intval(!scmp(term1.vstr, term2.vstr)));
  119.     case VT_SECT:
  120.     case VT_OP:
  121.     case VT_MAC: return(val_zero);
  122.     default:
  123.       fatal("`Not equal' operator applied to bogus type %d", term1.type);
  124.     }
  125. }
  126.  
  127. /* OPX:  Boolean not */
  128. struct val evbnot(cpp, term)
  129.   char **cpp;
  130.   struct val term;
  131. {
  132.   return(intval(!toint(term).vint));
  133. }
  134.  
  135.  
  136. /* OPX:  Logical complement */
  137. struct val evlnot(cpp, term)
  138.   char **cpp;
  139.   struct val term;
  140. {
  141.   return(intval(~toint(term).vint));
  142. }
  143.  
  144.  
  145. /* OPX:  Right mask */
  146. struct val evrmask(cpp, term)
  147.   char **cpp;
  148.   struct val term;
  149. {
  150.   return(intval((1 << toint(term).vint) - 1));
  151. }
  152.  
  153.  
  154. /* XOPY: Left shift */
  155. struct val evlshf(cpp, term1, term2)
  156.   char **cpp;
  157.   struct val term1, term2;
  158. {
  159.   term1 = toint(term1);
  160.   term2 = toint(term2);
  161.  
  162.   term1.vint <<= term2.vint;
  163.   
  164.   return(term1);
  165. }
  166.  
  167.  
  168. /* XOPY: Right shift */
  169. struct val evrshf(cpp, term1, term2)
  170.   char **cpp;
  171.   struct val term1,term2;
  172. {
  173.   term1 = toint(term1);
  174.   term2 = toint(term2);
  175.  
  176.   term1.vint >>= term2.vint;
  177.  
  178.   return(term1);
  179. }
  180.  
  181.  
  182. /* XOPY: Less than or equal */
  183. struct val evble(cpp, term1, term2)
  184.   char **cpp;
  185.   struct val term1, term2;
  186. {
  187.   if(term1.type != term2.type)
  188.     return(val_zero);
  189.  
  190.   switch(term1.type)
  191.     {
  192.     case VT_INT: return(intval(term1.vint <= term2.vint));
  193.     case VT_REAL: return(intval(term1.vdouble <= term2.vdouble));
  194.     case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) <= 0));
  195.     case VT_SECT:
  196.     case VT_OP:
  197.     case VT_MAC: return(val_zero);
  198.     default:
  199.       fatal("`Less than' operator applied to bogus type %d", term1.type);
  200.     }
  201. }
  202.  
  203.  
  204. /* XOPY: Greater than or equal */
  205. struct val evbge(cpp, term1, term2)
  206.   char **cpp;
  207.   struct val term1, term2;
  208. {
  209.   if(term1.type != term2.type)
  210.     return(val_zero);
  211.  
  212.   switch(term1.type)
  213.     {
  214.     case VT_INT: return(intval(term1.vint >= term2.vint));
  215.     case VT_REAL: return(intval(term1.vdouble >= term2.vdouble));
  216.     case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) >= 0));
  217.     case VT_OP:
  218.     case VT_SECT:
  219.     case VT_MAC: return(val_zero);
  220.     default:
  221.       fatal("`Greater than' operator applied to bogus type %d", term1.type);
  222.     }
  223. }
  224.  
  225.  
  226. /* XOPY: Less than */
  227. struct val evblt(cpp, term1, term2)
  228.   char **cpp;
  229.   struct val term1, term2;
  230. {
  231.   if(term1.type != term2.type)
  232.     return(val_zero);
  233.  
  234.   switch(term1.type)
  235.     {
  236.     case VT_INT: return(intval(term1.vint < term2.vint));
  237.     case VT_REAL: return(intval(term1.vdouble < term2.vdouble));
  238.     case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) < 0));
  239.     case VT_SECT:
  240.     case VT_OP:
  241.     case VT_MAC: return(val_zero);
  242.     default:
  243.       fatal("`Less than' operator applied to bogus type %d", term1.type);
  244.     }
  245. }
  246.  
  247.  
  248. /* XOPY: Greater than */
  249. struct val evbgt(cpp, term1, term2)
  250.   char **cpp;
  251.   struct val term1, term2;
  252. {
  253.   if(term1.type != term2.type)
  254.     return(val_zero);
  255.  
  256.   switch(term1.type)
  257.     {
  258.     case VT_INT: return(intval(term1.vint > term2.vint));
  259.     case VT_REAL: return(intval(term1.vdouble > term2.vdouble));
  260.     case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) > 0));
  261.     case VT_SECT:
  262.     case VT_OP:
  263.     case VT_MAC: return(val_zero);
  264.     default:
  265.       fatal("`Greater than' operator applied to bogus type %d", term1.type);
  266.     }
  267. }
  268.  
  269.  
  270. /* XOPY: Equal */
  271. struct val evbeq(cpp, term1, term2)
  272.   char **cpp;
  273.   struct val term1, term2;
  274. {
  275.   if(term1.type != term2.type)
  276.     return(val_zero);
  277.  
  278.   switch(term1.type)
  279.     {
  280.     case VT_INT: return(intval(term1.vint == term2.vint));
  281.     case VT_REAL: return(intval(term1.vdouble == term2.vdouble));
  282.     case VT_STR: return(intval(!scmp(term1.vstr, term2.vstr)));
  283.     case VT_SECT:
  284.     case VT_OP:
  285.     case VT_MAC: return(val_zero);
  286.     default:
  287.       fatal("`Equal to' operator applied to bogus type %d", term1.type);
  288.     }
  289. }
  290.  
  291.  
  292. /* XOPY: Boolean or */
  293. struct val evbor(cpp, term1, term2)
  294.   char **cpp;
  295.   struct val term1, term2;
  296. {
  297.   term1 = toint(term1);
  298.   term2 = toint(term2);
  299.  
  300.   if(term1.vint || term2.vint)
  301.     return(val_one);
  302.  
  303.   return(val_zero);
  304. }
  305.  
  306.  
  307. /* XOPY: Boolean and */
  308. struct val evband(cpp, term1, term2)
  309.   char **cpp;
  310.   struct val term1, term2;
  311. {
  312.   term1 = toint(term1);
  313.   term2 = toint(term2);
  314.  
  315.   if(term1.vint && term2.vint)
  316.     return(val_one);
  317.  
  318.   return(val_zero);
  319. }
  320.  
  321.  
  322. /* XOPY: Bitwise or */
  323. struct val evlor(cpp, term1, term2)
  324.   char **cpp;
  325.   struct val term1, term2;
  326. {
  327.   term1 = toint(term1);
  328.   term2 = toint(term2);
  329.  
  330.   return(intval(term1.vint | term2.vint));
  331. }
  332.  
  333.  
  334. /* XOPY: Bitwise and */
  335. struct val evland(cpp, term1, term2)
  336.   char **cpp;
  337.   struct val term1, term2;
  338. {
  339.   term1 = toint(term1);
  340.   term2 = toint(term2);
  341.  
  342.   return(intval(term1.vint & term2.vint));
  343. }
  344.  
  345.  
  346. /* XOPY: Boolean xor */
  347. struct val evbxor(cpp, term1, term2)
  348.   char **cpp;
  349.   struct val term1, term2;
  350. {
  351.   term1 = toint(term1);
  352.   term2 = toint(term2);
  353.  
  354.   if((!term1.vint && term2.vint) ||
  355.      (term1.vint && !term2.vint))
  356.     return(val_one);
  357.  
  358.   return(val_zero);
  359. }
  360.  
  361.  
  362. /* XOPY: Bitwise xor */
  363. struct val evlxor(cpp, term1, term2)
  364.   char **cpp;
  365.   struct val term1, term2;
  366. {
  367.   term1 = toint(term1);
  368.   term2 = toint(term2);
  369.  
  370.   return(intval(term1.vint ^ term2.vint));
  371. }
  372.  
  373.  
  374. /* XOPY: Add */
  375. struct val evadd(cpp, term1, term2)
  376.   char **cpp;
  377.   struct val term1, term2;
  378. {
  379.   extern char *expr_allp, *expr_strdup();
  380.  
  381.   /* If either is double, make both double and return double result */
  382.   if(term1.type == VT_REAL || term2.type == VT_REAL)
  383.     {
  384.       term1 = toreal(term1);
  385.       term2 = toreal(term2);
  386.  
  387.       return(realval(term1.vdouble + term2.vdouble));
  388.     }
  389.  
  390.   if(term1.type == VT_STR && term2.type == VT_STR)
  391.     {
  392.       /* Reallocate strings, and discard intermediate NUL */
  393.       term1.vstr = expr_strdup(term1.vstr);
  394.       expr_allp--;
  395.       expr_strdup(term2.vstr);
  396.       return(term1);
  397.     }
  398.  
  399.   term1 = toint(term1);
  400.   term2 = toint(term2);
  401.  
  402.   return(intval(term1.vint + term2.vint));
  403. }
  404.  
  405.  
  406. /* XOPY: Subtract */
  407. struct val evsub(cpp, term1, term2)
  408.   char **cpp;
  409.   struct val term1, term2;
  410. {
  411.   /* If either is double, make both double and return double result */
  412.   if(term1.type == VT_REAL || term2.type == VT_REAL)
  413.     {
  414.       term1 = toreal(term1);
  415.       term2 = toreal(term2);
  416.       
  417.       return(realval(term1.vdouble - term2.vdouble));
  418.     }
  419.  
  420.   term1 = toint(term1);
  421.   term2 = toint(term2);
  422.  
  423.   return(intval(term1.vint - term2.vint));
  424. }
  425.  
  426.  
  427. /* OPX: Unary minus */
  428. struct val evneg(cpp, term)
  429.   char **cpp;
  430.   struct val term;
  431. {
  432.   /* If term is double, make it double and return double result */
  433.   if(term.type == VT_REAL)
  434.     {
  435.       term = toreal(term);
  436.  
  437.       return(realval(-term.vdouble));
  438.     }
  439.  
  440.   return(intval(-toint(term).vint));
  441. }
  442.  
  443.  
  444. /* XOPY: Division */
  445. struct val evdiv(cpp, term1, term2)
  446.   char **cpp;
  447.   struct val term1, term2;
  448. {
  449.   /* If either is double, make the other double and return double result */
  450.   if(term1.type == VT_REAL || term2.type == VT_REAL)
  451.     {
  452.       term1 = toreal(term1);
  453.       term2 = toreal(term2);
  454.  
  455.       return(realval(term1.vdouble / term2.vdouble));
  456.     }
  457.  
  458.   term1 = toint(term1);
  459.   term2 = toint(term2);
  460.  
  461.   return(intval(term1.vint / term2.vint));
  462. }
  463.  
  464.  
  465. /* XOPY: Multiplication */
  466. struct val evmul(cpp, term1, term2)
  467.   char **cpp;
  468.   struct val term1, term2;
  469. {
  470.   /* If either is double, make both double and return double result */
  471.   if(term1.type == VT_REAL || term2.type == VT_REAL)
  472.     {
  473.       term1 = toreal(term1);
  474.       term2 = toreal(term2);
  475.  
  476.       return(realval(term1.vdouble * term2.vdouble));
  477.     }
  478.  
  479.   term1 = toint(term1);
  480.   term2 = toint(term2);
  481.  
  482.   return(intval(term1.vint * term2.vint));
  483. }
  484.  
  485.  
  486. /* XOPY: Modulo */
  487. struct val  evmod(cpp, term1, term2)
  488.   char **cpp;
  489.   struct val term1, term2;
  490. {
  491.   /* If either is double, make both double and return double result */
  492.   if(term1.type == VT_REAL || term2.type == VT_REAL)
  493.     {
  494.       term1 = toreal(term1);
  495.       term2 = toreal(term2);
  496.  
  497.       return(realval(fmod(term1.vdouble, term2.vdouble)));
  498.     }
  499.  
  500.   term1 = toint(term1);
  501.   term2 = toint(term2);
  502.  
  503.   return(intval(term1.vint % term2.vint));
  504. }
  505.  
  506.  
  507. /* OPX: Bit field */
  508. struct val evbits(cpp)
  509.   char **cpp;
  510. {
  511.   int tmp, tmpx;
  512.   
  513.   tmp = 0;
  514.   noseq = TRUE;
  515.   
  516.   for(;;)
  517.     {
  518.       /* Evaluate expression */
  519.       tmpx = toint(evexpr(cpp)).vint;
  520.       tmp |= (1 << tmpx);
  521.       
  522.       /* Is there another entry in line? */
  523.       *cpp = byspace(*cpp);
  524.       
  525.       if(**cpp != ',')
  526.     if(**cpp != ']')
  527.       {
  528.         sgnerr("Bad bit field element");
  529.         return(val_zero);
  530.       }
  531.     else    /* End of field */
  532.       {
  533.         (*cpp)++;
  534.         return(intval(tmp));
  535.       }
  536.       
  537.       /* Further arguments */
  538.       *cpp = byspace(++(*cpp));
  539.     }
  540. }
  541.  
  542.  
  543. /* OPX: Octal number conversion */
  544. struct val evoct(cpp)
  545.   char **cpp;
  546. {
  547.   INT tmp;
  548.   char *save = *cpp;
  549.   extern struct fstruct *fhit;
  550.   
  551.   noseq = TRUE;
  552.   tmp = (INT) 0;
  553.   
  554.   if(!isoct(**cpp))
  555.     {
  556.       /* Prefix "0" is a special case, which is correct */
  557.       if(!fhit->auxval)
  558.     sgnerr("Invalid octal constant");
  559.  
  560.       return(val_zero);
  561.     }
  562.   
  563.   /* Loop until no more digits */
  564.   while(isoct(**cpp))
  565.     {
  566.       tmp *= 8L;
  567.       tmp += **cpp - 48L;
  568.       (*cpp)++;
  569.     }
  570.   
  571.   /* Dot or 'e' - then redo as real */
  572.   if(toupper(**cpp) == 'E' || **cpp == '.')
  573.     {
  574.       *cpp = save;
  575.       return(evreal(cpp));
  576.     }
  577.  
  578.   return(intval(tmp));
  579. }
  580.  
  581.  
  582. /* OPX: Binary number conversion */
  583. struct val evbin(cpp)
  584.   char **cpp;
  585. {
  586.   INT tmp;
  587.   char *save = *cpp;
  588.   
  589.   noseq = TRUE;
  590.   tmp = 0L;
  591.   
  592.   is_digit(**cpp);
  593.   
  594.   /* Loop until no more digits */
  595.   while(**cpp == '0' || **cpp == '1')
  596.     {
  597.       tmp += tmp;
  598.       tmp += **cpp - 48L;
  599.       (*cpp)++;
  600.     }
  601.   
  602.   /* Dot or 'e' - then redo as real */
  603.   if(toupper(**cpp) == 'E' || **cpp == '.')
  604.     {
  605.       *cpp = save;
  606.       return(evreal(cpp));
  607.     }
  608.  
  609.   return(intval(tmp));
  610. }
  611.  
  612.  
  613. /* OPX: Real number parsing */
  614. struct val evreal(cpp)
  615.   char **cpp;
  616. {
  617.   extern double strtod();
  618.  
  619.   return(realval((REAL) strtod(*cpp, cpp)));
  620. }
  621.  
  622.  
  623. /* OPX: return local symbol value */
  624. struct val evlocal(cpp)
  625.   char **cpp;
  626. {
  627.   extern struct val local_value();
  628.  
  629.   return(local_value((unsigned long) evdec(cpp).vint));
  630. }
  631.  
  632.  
  633. /* OPX: Decimal number conversion */
  634. struct val evdec(cpp)
  635.   char **cpp;
  636. {
  637.   INT tmp;
  638.   char *save = *cpp;
  639.   
  640.   noseq = TRUE;
  641.   tmp = (INT) 0;
  642.   
  643.   is_digit(**cpp);
  644.   
  645.   /* Loop until no more digits */
  646.   while(isdigit(**cpp))
  647.     {
  648.       tmp *= 10L;
  649.       tmp += **cpp - 48L;
  650.       (*cpp)++;
  651.     }
  652.   
  653.   /* Dot or 'e' - then redo as real */
  654.   if(toupper(**cpp) == 'E' || **cpp == '.')
  655.     {
  656.       *cpp = save;
  657.       return(evreal(cpp));
  658.     }
  659.   
  660.   return(intval(tmp));
  661. }
  662.  
  663.  
  664. /* OPX: Hexadecimal number conversion */
  665. struct val evhex(cpp)
  666.   char **cpp;
  667. {
  668.   INT tmp;
  669.   char *save = *cpp;
  670.   
  671.   tmp = (INT) 0;
  672.   noseq = TRUE;
  673.  
  674.   if(!ishex(**cpp))
  675.     {
  676.       sgnerr("Invalid hex constant");
  677.       return(val_zero);
  678.     }
  679.   
  680.   /* Loop until no more digits */
  681.   while(ishex(**cpp))
  682.     {
  683.       tmp *= 16L;
  684.       tmp += ((**cpp >= '0' && **cpp <= '9') ?
  685.           (**cpp - 48L)        :
  686.           ((**cpp & ~32L) - 55L));
  687.       (*cpp)++;
  688.     }
  689.  
  690.   
  691.   return(intval(tmp));
  692. }
  693.  
  694.  
  695. /* OPX: Opening parenthesis */
  696. struct val evleft(cpp)
  697.   char **cpp;
  698. {
  699.   struct val tmp;
  700.  
  701.   /* Evaluate expression */
  702.   *cpp = byspace(*cpp);
  703.   tmp = evexpr(cpp);
  704.   
  705.   mustbe(cpp, ')');
  706.   
  707.   return(tmp);
  708. }
  709.  
  710.  
  711. /* Scan symbol in stream */
  712. char *scansym(cpp, tmpcp)
  713.   char **cpp, *tmpcp;
  714. {
  715.   char *cp;
  716.   
  717.   
  718.   /* Find first nonsymbol char */
  719.   for(cp = *cpp = byspace(*cpp); issym(**cpp); (*cpp)++);
  720.   
  721.   /* Save and replace it with '\0' */
  722.   *tmpcp = **cpp;
  723.   **cpp = '\0';
  724.  
  725.   if(!*cp)
  726.     sgnerr("Null symbol name");
  727.  
  728.   return(cp);
  729. }
  730.  
  731.  
  732. /* OPX: Test if symbol is defined */
  733. struct val evdefd(cpp)
  734.   char **cpp;
  735. {
  736.   int tmpi;
  737.   char tmpc, *cp;
  738.   SYM_NODE *symp;
  739.   extern char *scansym();
  740.  
  741.   
  742.   /* Scan symbol and look it up */
  743.   *cpp = byspace(*cpp);
  744.   cp = scansym(cpp, &tmpc);
  745.  
  746.   tmpi = (symp = sm_find_sym(symtbl, cp)) && !(symp->flags & F_UDF);
  747.   
  748.   /* Restore delimiter and return */
  749.   cp[strlen(cp)] = tmpc;
  750.   return(intval(tmpi));
  751. }
  752.  
  753.  
  754. /* OPX: Return current location */
  755. struct val evloc0()
  756. {
  757.   return(intval(loc0));
  758. }
  759.  
  760.  
  761. /* OPX: Return current pass */
  762. struct val evpass()
  763. {
  764.   extern pass;
  765.  
  766.   return(intval(pass));
  767. }
  768.  
  769.  
  770. /* OPX: Return running Kermit CRC */
  771. struct val evkcrc()
  772. {
  773.   extern unsigned long kcrc;
  774.  
  775.   return(intval((INT) (kcrc & 0xffff)));
  776. }
  777.  
  778.  
  779. /* OPX: generate symbol */
  780. struct val evgensym()
  781. {
  782.   extern char *expr_strdup();
  783.   extern struct val strval();
  784.   char symname[64];
  785.   extern gensym_ctr;
  786.  
  787.   sprintf(symname, "L_%05u", gensym_ctr++);
  788.   
  789.   return(strval(expr_strdup(symname)));
  790. }
  791.  
  792.  
  793. /* OPX: return instance level of symbol */
  794. struct val evinstances(cpp)
  795.   char **cpp;
  796. {
  797.   char c, *name;
  798.   int i;
  799.   extern char *scansym();
  800.  
  801.   name = scansym(cpp, &c);
  802.   i = instances(name);
  803.     
  804.   name[strlen(name)] = c;
  805.   return(intval(i));
  806. }
  807.  
  808.  
  809. /* OPX: string */
  810. struct val evstr(cpp)
  811.   char **cpp;
  812. {
  813.   char *s;
  814.   struct val v;
  815.  
  816.   (*cpp)--;            /* Back up to quote */
  817.   v.type = VT_STR;
  818.   v.vstr = str(cpp);
  819.  
  820.   return(v);
  821. }
  822.  
  823.  
  824. /* XOPY: return left portion of string */
  825. struct val evleftstr(cpp, term1, term2)
  826.   char **cpp;
  827.   struct val term1, term2;
  828. {
  829.   term1 = tostr(term1);
  830.   term2 = toint(term2);
  831.  
  832.   if(term2.vint < 0 || term2.vint > strlen(term1.vstr))
  833.     return(term1);
  834.  
  835.   term1.vstr[term2.vint] = '\0';
  836.   return(term1);
  837. }
  838.  
  839.  
  840. /* XOPY: return right portion of string */
  841. struct val evrightstr(cpp, term1, term2)
  842.   char **cpp;
  843.   struct val term1, term2;
  844. {
  845.   term1 = tostr(term1);
  846.   term2 = toint(term2);
  847.  
  848.   if(term2.vint < 0 || term2.vint > strlen(term1.vstr))
  849.     return(term1);
  850.  
  851.   term1.vstr += term2.vint - 1;
  852.   return(term1);
  853. }
  854.  
  855.  
  856. /* OPX: int to string by ascii value */
  857. struct val evchartostr(cpp, term)
  858.   char **cpp;
  859.   struct val term;
  860. {
  861.   char buf[2];
  862.   extern char *expr_strdup();
  863.  
  864.   term = toint(term);
  865.   
  866.   buf[1] = '\0';
  867.   buf[0] = term.vint;
  868.  
  869.   term.vstr = expr_strdup(buf);
  870.   term.type = VT_STR;
  871.  
  872.   return(term);
  873. }
  874.  
  875.  
  876. /* OPX string length */
  877. struct val evstrlen(cpp, term)
  878.   char **cpp;
  879.   struct val term;
  880. {
  881.   term = tostr(term);
  882.  
  883.   term.vint = strlen(term.vstr);
  884.   term.type = VT_INT;
  885.   return(term);
  886. }
  887.  
  888.  
  889. /* OPX: trim leading spaces */
  890. struct val evtrimld(cpp, term)
  891.   char **cpp;
  892.   struct val term;
  893. {
  894.   term = tostr(term);
  895.   term.vstr = byspace(term.vstr);
  896.   return(term);
  897. }
  898.  
  899.  
  900. /* OPX: trim trailing spaces */
  901. struct val evtrimtr(cpp, term)
  902.   char **cpp;
  903.   struct val term;
  904. {
  905.   register char *cp;
  906.  
  907.   term = tostr(term);
  908.  
  909.   for(cp = term.vstr + strlen(term.vstr) - 1; cp >= term.vstr; cp--)
  910.     if((unsigned char) *cp > ' ')
  911.       {
  912.     *++cp = '\0';
  913.     return(term);
  914.       }
  915.  
  916.   term.vstr[0] = '\0';
  917.   return(term);
  918. }
  919.  
  920.  
  921. /* OPX: eval */
  922. struct val eveval(cpp, term)
  923.   char **cpp;
  924.   struct val term;
  925. {
  926.   char *cp;
  927.  
  928.   /* All types except strings evaluate to themselves */
  929.   if(term.type != VT_STR)
  930.     return(term);
  931.  
  932.   cp = term.vstr;
  933.   return(evexpr(&cp));
  934. }
  935.  
  936.  
  937. /* OPX: uppercase conversion */
  938. struct val evuc(cpp, term)
  939.   char **cpp;
  940.   struct val term;
  941. {
  942.   extern struct val uppercase();
  943.  
  944.   return(uppercase(term));
  945. }
  946.  
  947.  
  948. /* OPX: Recursive assembly.
  949.  * Should be recoded so it doesn't use goto's.
  950.  */
  951. struct val evinstr(cpp, term)
  952.   char **cpp;
  953.   struct val term;
  954. {
  955.   char
  956.     *oldcodebuf, *oldcodeptr, *str, *tmp, tmpc, termc, *asnarg;
  957.   int
  958.     low, hi, center, old_codeblock = codeblock;
  959.   SYM_NODE *symp;
  960.   extern char
  961.     *malloc(), codebuf[], *codeptr;
  962.   extern struct istruct instbl[];
  963.   extern
  964.     hitlo[], hithi[], scmp(), symtop;
  965.   
  966.  
  967.   if(term.type != VT_STR)
  968.     return(toint(term));
  969.  
  970.   if(codeptr > codebuf)
  971.     {
  972.       oldcodebuf = malloc(codeptr-codebuf);
  973.       bcopy(codebuf, oldcodebuf, codeptr-codebuf);
  974.     }
  975.  
  976.   /* Block out code generation */
  977.   codeblock = TRUE;
  978.  
  979.   oldcodeptr = codeptr;
  980.   codeptr = codebuf;
  981.  
  982.   str = term.vstr;
  983.   
  984.   /* Extract first word */
  985.   if(*(str = byspace(str)) == ';' || *str < '\040')
  986.     {
  987.       term = val_zero;
  988.       goto restore_ret;
  989.     }
  990.   
  991.   for(tmp = str; *str > ' ' && (str == tmp || *str != '.') && *str != '=';
  992.       str++);
  993.  
  994.   termc = *str;
  995.   *str = '\0';
  996.  
  997.   tmpc = toupper(*tmp)-32;
  998.   
  999.   /* Is it "name = expr"? */
  1000.   if(termc && (termc == '=' || *byspace(str+1) == '='))
  1001.     {
  1002.       char defstr[132];
  1003.       extern void ddef(), dorg();
  1004.       extern struct val val_nullstr, localize();
  1005.  
  1006.       static struct istruct
  1007.     defs = {"=", ddef, 0, 0},
  1008.     dorgs = {"=", dorg, 0, 0};
  1009.  
  1010.       if(tmp[0] == '.' && !tmp[1])
  1011.     {
  1012.       sprintf(defstr, " %s", byspace(str + (termc == '=' ? 1 : 2)));
  1013.       dorg(&dorgs, defstr);
  1014.     }
  1015.       else
  1016.     {
  1017.       sprintf(defstr, " %s %s", tmp,
  1018.           byspace(str + (termc == '=' ? 1 : 2)));
  1019.       ddef(&defs, defstr);
  1020.     }
  1021.  
  1022.       *str = termc;
  1023.       term = localize(val_nullstr);
  1024.       goto restore_ret;
  1025.     }
  1026.  
  1027.   /* Expand if macro */
  1028.   if((symp = sm_find_sym(symtbl, tmp)) && symp->value.type == VT_MAC)
  1029.     {
  1030.       *str = termc;
  1031.       expand_macro(symp->value.vmacro, byspace(str));
  1032.       goto return_codebuf;
  1033.     }
  1034.  
  1035.   /* Look it up in the instruction table */
  1036.   if((low = hitlo[tmpc]) >= 0 && low <= symtop)
  1037.     for(hi = hithi[tmpc]; hi >= low;)
  1038.       switch(scmp(tmp, instbl[center = (hi + low) >> 1].name))
  1039.     {        /* Aim */
  1040.     case -1:    /* Hi  */    hi  = center-1; break;
  1041.     case 1:        /* Low */    low = center+1; break;
  1042.     default:    /* Eq  */    goto found;
  1043.     }
  1044.   
  1045.   /* Not a macro or instruction */
  1046.   sgnerr("Undefined instruction or macro - `%s'", tmp);
  1047.   goto return_codebuf;
  1048.   
  1049.   /* Instruction found */
  1050.  found:
  1051.   
  1052.   /* Restore string */
  1053.   *str = termc;
  1054.  
  1055.   /* Translate operands and generate code */
  1056.   (*instbl[center].scandef)(&instbl[center], str);
  1057.  
  1058.  return_codebuf:
  1059.  
  1060.   /* Restore old codebuf and return new, low-endian */
  1061.   term.type = VT_INT;
  1062.   term.vint = 0;
  1063.  
  1064.   while(codeptr-- > codebuf)
  1065.     {
  1066.       term.vint <<= 4;
  1067.       term.vint |= (unsigned char) *codeptr;
  1068.     }
  1069.  
  1070.  restore_ret:
  1071.   
  1072.   if(oldcodeptr > codebuf)
  1073.     {
  1074.       bcopy(oldcodebuf, codebuf, oldcodeptr-codebuf);
  1075.       free(oldcodebuf);
  1076.     }
  1077.  
  1078.   codeblock = old_codeblock;
  1079.   codeptr = oldcodeptr;
  1080.   return(term);
  1081. }
  1082.  
  1083.  
  1084. /* OPX: Recursive assembly.
  1085.  * Should be recoded so it doesn't use goto's.
  1086.  *
  1087.  * Same as evinstr(), but returns number of nibbles instead.
  1088.  * The code here should be generalized with assemble_line() and
  1089.  * expand_body() as well as evinstr().
  1090.  */
  1091. struct val evinstrlen(cpp, term)
  1092.   char **cpp;
  1093.   struct val term;
  1094. {
  1095.   char
  1096.     *oldcodebuf, *oldcodeptr, *str, *tmp, tmpc, termc, *asnarg;
  1097.   int
  1098.     low, hi, center, old_codeblock = codeblock;
  1099.   SYM_NODE *symp;
  1100.   extern char
  1101.     *malloc(), codebuf[], *codeptr;
  1102.   extern struct istruct
  1103.     instbl[];
  1104.   extern
  1105.     hitlo[], hithi[], scmp(), symtop;
  1106.   
  1107.  
  1108.   if(term.type != VT_STR)
  1109.     return(toint(term));
  1110.  
  1111.   if(codeptr > codebuf)
  1112.     {
  1113.       oldcodebuf = malloc(codeptr-codebuf);
  1114.       bcopy(codebuf, oldcodebuf, codeptr-codebuf);
  1115.     }
  1116.  
  1117.   /* Block out code generation */
  1118.   codeblock = TRUE;
  1119.  
  1120.   oldcodeptr = codeptr;
  1121.   codeptr = codebuf;
  1122.  
  1123.   str = term.vstr;
  1124.   
  1125.   /* Extract first word */
  1126.   if(*(str = byspace(str)) == ';' || *str < '\040')
  1127.     {
  1128.       term = val_zero;
  1129.       goto restore_ret;
  1130.     }
  1131.   
  1132.   for(tmp = str; *str > ' ' && (str == tmp || *str != '.') && *str != '=';
  1133.       str++);
  1134.  
  1135.   termc = *str;
  1136.   *str = '\0';
  1137.  
  1138.   tmpc = toupper(*tmp)-32;
  1139.   
  1140.   /* Is it "name = expr"? */
  1141.   if(termc && (termc == '=' || *byspace(str+1) == '='))
  1142.     {
  1143.       char defstr[132];
  1144.       extern void ddef(), dorg();
  1145.       extern struct val val_nullstr, localize();
  1146.  
  1147.       static struct istruct
  1148.     defs = {"=", ddef, 0, 0},
  1149.     dorgs = {"=", dorg, 0, 0};
  1150.  
  1151.       if(tmp[0] == '.' && !tmp[1])
  1152.     {
  1153.       sprintf(defstr, " %s", byspace(str + (termc == '=' ? 1 : 2)));
  1154.       dorg(&dorgs, defstr);
  1155.     }
  1156.       else
  1157.     {
  1158.       sprintf(defstr, " %s %s", tmp,
  1159.           byspace(str + (termc == '=' ? 1 : 2)));
  1160.       ddef(&defs, defstr);
  1161.     }
  1162.  
  1163.       *str = termc;
  1164.       term = localize(val_zero);
  1165.       goto restore_ret;
  1166.     }
  1167.  
  1168.   /* Expand if macro */
  1169.   if((symp = sm_find_sym(symtbl, tmp)) && symp->value.type == VT_MAC)
  1170.     {
  1171.       *str = termc;
  1172.       expand_macro(symp->value.vmacro, byspace(str));
  1173.       goto return_codebuf;
  1174.     }
  1175.  
  1176.   /* Look it up in the instruction table */
  1177.   if((low = hitlo[tmpc]) >= 0 && low <= symtop)
  1178.     for(hi = hithi[tmpc]; hi >= low;)
  1179.       switch(scmp(tmp, instbl[center = (hi + low) >> 1].name))
  1180.     {        /* Aim */
  1181.     case -1:    /* Hi  */    hi  = center-1; break;
  1182.     case 1:        /* Low */    low = center+1; break;
  1183.     default:    /* Eq  */    goto found;
  1184.     }
  1185.   
  1186.   /* Not a macro or instruction */
  1187.   sgnerr("Undefined instruction or macro - `%s'", tmp);
  1188.   goto return_codebuf;
  1189.   
  1190.   /* Instruction found */
  1191.  found:
  1192.   
  1193.   /* Restore string */
  1194.   *str = termc;
  1195.  
  1196.   /* Translate operands and generate code */
  1197.   (*instbl[center].scandef)(&instbl[center], str);
  1198.  
  1199.  return_codebuf:
  1200.  
  1201.   /* Restore old codebuf and return new, low-endian */
  1202.   term.type = VT_INT;
  1203.   term.vint = 0;
  1204.  
  1205.   term.vint = codeptr - codebuf;
  1206.  
  1207.  restore_ret:
  1208.   
  1209.   if(oldcodeptr > codebuf)
  1210.     {
  1211.       bcopy(oldcodebuf, codebuf, oldcodeptr-codebuf);
  1212.       free(oldcodebuf);
  1213.     }
  1214.  
  1215.   codeptr = oldcodeptr;
  1216.   return(term);
  1217. }
  1218.  
  1219.  
  1220. /* OPX: Return type */
  1221. struct val evtype(cpp, term)
  1222.   char **cpp;
  1223.   struct val term;
  1224. {
  1225.   return(intval((INT) term.type));
  1226. }
  1227.  
  1228.  
  1229. /* XOPY: power */
  1230. struct val evpow(cpp, term1, term2)
  1231.   char **cpp;
  1232.   struct val term1, term2;
  1233. {
  1234.   return(realval(pow((double) toreal(term1).vdouble,
  1235.              (double) toreal(term2).vdouble)));
  1236. }
  1237.  
  1238.  
  1239. struct stdent {
  1240.   double (*stdfun)();        /* Function */
  1241.   int enabled;            /* Enabled on this system */
  1242. }
  1243. ftable[] = {
  1244.   {acos, TRUE}, {asin, TRUE},
  1245.   {atan, TRUE}, {ceil, TRUE}, {cos, TRUE}, {cosh, TRUE},
  1246.   {exp, TRUE}, {fabs, TRUE}, {floor, TRUE}, {fmod, TRUE},
  1247.   {log, TRUE}, {log10, TRUE}, {sin, TRUE}, {sinh, TRUE},
  1248.   {sqrt, TRUE}, {tan, TRUE}, {tanh, TRUE}};
  1249.  
  1250.  
  1251. /* OPX: standard functions */
  1252. struct val evfun(cpp, term)
  1253.   char **cpp;
  1254.   struct val term;
  1255. {
  1256.   int nthfun;
  1257.   extern struct fstruct *fhit;
  1258.   extern struct val val_real0;
  1259.   
  1260.   nthfun = fhit->auxval;
  1261.   if(!ftable[nthfun].enabled)
  1262.     {
  1263.       sgnerr("Function `%s' not supported on this system", fhit->name);
  1264.       return(val_real0);
  1265.     }
  1266.  
  1267. #ifdef MSDOS
  1268.   {
  1269.     REAL ret1 = (*ftable[nthfun].stdfun)((double) toreal(term).vdouble);
  1270.     return(realval(ret1));
  1271.   }
  1272. #else
  1273.   return(realval((REAL)
  1274.          (*ftable[nthfun].stdfun)((double) toreal(term).vdouble)));
  1275. #endif
  1276. }
  1277.  
  1278.  
  1279. /* OPX: real to bin */
  1280. struct val evrtobin(cpp, term)
  1281.   char **cpp;
  1282.   struct val term;
  1283. {
  1284.   struct val v;
  1285.   INT i = 0;
  1286.   int xs, digit;
  1287.   term = toreal(term);
  1288.  
  1289.  
  1290.   /* Sign nibble */
  1291.   i = (v.vdouble < 0.0 ? 9 : 0);
  1292.  
  1293.   xs = EXPONENT(v.vdouble);
  1294.  
  1295.   /* Mantissa */
  1296.   v.vdouble /= pow(10.0, (REAL) xs);
  1297.  
  1298.   if(v.vdouble < 0.0)
  1299.     v.vdouble = -v.vdouble;
  1300.  
  1301.   for(digit = 0; digit < 12; digit++)
  1302.     {
  1303.       i <<= 4;
  1304.       i += (INT) floor(v.vdouble = fmod(v.vdouble, 10.0));
  1305.       v.vdouble *= 10.0;
  1306.     }
  1307.  
  1308.   /* Exponent */
  1309.   i <<= 12;
  1310.  
  1311.   if(xs >= 0)
  1312.     i |= (xs & 0xfff);
  1313.   else
  1314.     {
  1315.       int axs = -xs;
  1316.       i |= (0x99a -
  1317.         (((axs / 100) << 8) |
  1318.          (((axs / 10) % 10) << 4) |
  1319.          (axs % 10))) & 0xfff;
  1320.     }
  1321.  
  1322.   v.type = VT_INT;
  1323.   v.vint = i;
  1324.   return(v);
  1325. }
  1326.   
  1327.  
  1328. /* OPX: Pooled Literal */
  1329. struct val evliteral(cpp, term)
  1330.   char **cpp;
  1331.   struct val term;
  1332. {
  1333.   char
  1334.     *oldcodebuf, *oldcodeptr, *str, *tmp, tmpc, termc, *asnarg;
  1335.   int
  1336.     low, hi, center;
  1337.   SYM_NODE *symp;
  1338.   long
  1339.     save_loc = loc, save_loc0 = loc0;
  1340.   extern char
  1341.     *malloc(), codebuf[], *codeptr;
  1342.   extern struct istruct
  1343.     instbl[];
  1344.   extern
  1345.     hitlo[], hithi[], scmp(), symtop, pass;
  1346.  
  1347.  
  1348.   term = tostr(term);
  1349.   
  1350.   if(codeptr > codebuf)
  1351.     {
  1352.       oldcodebuf = malloc(codeptr-codebuf);
  1353.       bcopy(codebuf, oldcodebuf, codeptr-codebuf);
  1354.     }
  1355.  
  1356.   oldcodeptr = codeptr;
  1357.   codeptr = codebuf;
  1358.  
  1359.   str = term.vstr;
  1360.   
  1361.   /* Extract first word */
  1362.   if(*(str = byspace(str)) == ';' || *str < '\040')
  1363.     {
  1364.       term = val_zero;
  1365.       goto restore_ret;
  1366.     }
  1367.   
  1368.   for(tmp = str; *str > ' ' && (str == tmp || *str != '.') && *str != '=';
  1369.       str++);
  1370.  
  1371.   termc = *str;
  1372.   *str = '\0';
  1373.  
  1374.   tmpc = toupper(*tmp)-32;
  1375.   
  1376.   /* Is it "name = expr"? */
  1377.   if(termc && (termc == '=' || *byspace(str+1) == '='))
  1378.     {
  1379.       sgnerr("Invalid literal");
  1380.       term = intval(add_literal(codebuf, 0));
  1381.       goto restore_ret;
  1382.     }
  1383.  
  1384.   /* Expand if macro */
  1385.   if((symp = sm_find_sym(symtbl, tmp)) && symp->value.type == VT_MAC)
  1386.     {
  1387.       *str = termc;
  1388.       expand_macro(symp->value.vmacro, byspace(str));
  1389.       goto return_litaddr;
  1390.     }
  1391.  
  1392.   /* Look it up in the instruction table */
  1393.   if((low = hitlo[tmpc]) >= 0 && low <= symtop)
  1394.     for(hi = hithi[tmpc]; hi >= low;)
  1395.       switch(scmp(tmp, instbl[center = (hi + low) >> 1].name))
  1396.     {        /* Aim */
  1397.     case -1:    /* Hi  */    hi  = center-1; break;
  1398.     case 1:        /* Low */    low = center+1; break;
  1399.     default:    /* Eq  */    goto found;
  1400.     }
  1401.   
  1402.   /* Not a macro or instruction */
  1403.   sgnerr("Undefined instruction or macro - `%s'", tmp);
  1404.  
  1405.   term = val_zero;
  1406.   goto restore_ret;
  1407.   
  1408.   /* Instruction found */
  1409.  found:
  1410.   
  1411.   /* Restore string */
  1412.   *str = termc;
  1413.  
  1414.   /* Translate operands and generate code */
  1415.   (*instbl[center].scandef)(&instbl[center], str);
  1416.  
  1417.  
  1418.   /* Add code to literal pool and return address */
  1419.  
  1420.  return_litaddr:
  1421.  
  1422.   loc0 = save_loc0;
  1423.   loc  = save_loc;
  1424.  
  1425.   term.type = VT_INT;
  1426.   term.vint = add_literal(codebuf, codeptr-codebuf);
  1427.   
  1428.  
  1429.   /* Restore codebuf and return */
  1430.  
  1431.  restore_ret:
  1432.   
  1433.   loc0 = save_loc0;
  1434.   loc  = save_loc;
  1435.  
  1436.   if(oldcodeptr > codebuf)
  1437.     {
  1438.       bcopy(oldcodebuf, codebuf, oldcodeptr-codebuf);
  1439.       free(oldcodebuf);
  1440.     }
  1441.  
  1442.   codeptr = oldcodeptr;
  1443.   return(term);
  1444. }
  1445.  
  1446.  
  1447. /* OPX: Test if symbol is LIBCALLed
  1448.  */
  1449. struct val evused(cpp)
  1450.   char **cpp;
  1451. {
  1452.   char *cp, tmpc;
  1453.   SYM_NODE *tmps;
  1454.   extern char *scansym();
  1455.  
  1456.   
  1457.   /* Scan symbol and look it up */
  1458.   *cpp = byspace(*cpp);
  1459.   cp = scansym(cpp, &tmpc);
  1460.  
  1461.   if(!(tmps = sm_find_sym(symtbl, cp)))
  1462.     return(val_zero);
  1463.   
  1464.   /* Return status */
  1465.   return(intval((tmps->flags & F_USED) != 0));
  1466. }
  1467.